home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tsptp.zip / SAVAGE.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-09  |  2KB  |  77 lines
  1. (******************************************************************************)
  2. (*                                 SAVAGE.PAS                                 *)
  3. (*  Derived from the BYTE listings.  Floating point speed and accuracy test.  *)
  4. (*  A BASIC version appeared in Dr. Dobb's Journal, Sep. 1983, pp. 120-122.   *)
  5. (******************************************************************************)
  6.  
  7. PROGRAM SAVAGE(Output);
  8.  
  9. (******************************************************************************)
  10. (*                                TIMING                                      *)
  11. (******************************************************************************)
  12.  
  13. (*$IFNDEF TopSpeed *)
  14.  (*%F TRUE   *** Compile for Turbo Pascal ***)
  15.   USES TPBench;
  16.  (*%E*)
  17. (*$ELSE     *** Compile for TopSpeed Pascal ***)
  18.   IMPORT TSBench *;
  19. (*$ENDIF *)
  20.  
  21. (******************************************************************************)
  22.  
  23.   VAR
  24.     A : BmReal;
  25.  
  26.   FUNCTION Tan(x : BmReal): BmReal;
  27.     (* Note no range checking is performed. *)
  28.   BEGIN
  29.     Tan := sin(x) / cos(x);
  30.   END;
  31.  
  32.   PROCEDURE SavageProc;
  33.     VAR I : BmInt;
  34.   BEGIN
  35.  
  36.     A := 1.0;
  37.  
  38.     FOR I := 1 TO 2500 DO
  39.       A := Tan(arctan(exp(ln(sqrt(A * A))))) + 1.0;
  40.  
  41.   END;
  42.  
  43. BEGIN
  44.   WriteLn('Savage Benchmark');
  45.  
  46. (******************************************************************************)
  47. (*  Compute the looping overhead.  The Dummy procedure must have some side-   *)
  48. (*  effect so that it is not optimised out of existence.                      *)
  49. (******************************************************************************)
  50.  
  51.   StartTimer;                                   (* Start the clock.           *)
  52.  
  53.   REPEAT
  54.     Dummy;
  55.   UNTIL NullTimesUp;
  56.  
  57. (******************************************************************************)
  58. (*  Now run the benchmark.  Note that the Dummy procedure is also called so   *)
  59. (*  that we can eliminate its overhead from the looping overhead.             *)
  60. (******************************************************************************)
  61.  
  62.   StartTimer;                                   (* Start the clock.           *)
  63.  
  64.   REPEAT
  65.     SavageProc;
  66.     Dummy
  67.   UNTIL BenchTimesUp;
  68.  
  69. (******************************************************************************)
  70.  
  71.   ReportTimes;
  72.  
  73.   WriteLn;
  74.   WriteLn('Result: A = ', A:10);
  75.  
  76. END.
  77.